home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / lib / kde4 / libexec / fileshareset < prev    next >
Text File  |  2008-05-21  |  11KB  |  426 lines
  1. #!/usr/bin/perl -T
  2. use strict;
  3.  
  4. ########################################
  5. # config files
  6. $nfs_exports::default_options = '*(ro,all_squash)';
  7. $nfs_exports::conf_file = '/etc/exports';
  8. $smb_exports::conf_file = '/etc/samba/smb.conf';
  9. my $authorisation_file = '/etc/security/fileshare.conf';
  10. my $authorisation_group = 'fileshare';
  11.  
  12.  
  13. ########################################
  14. # Copyright (C) 2001-2002 MandrakeSoft (pixel@mandrakesoft.com)
  15. #
  16. # This program is free software; you can redistribute it and/or modify
  17. # it under the terms of the GNU General Public License as published by
  18. # the Free Software Foundation; either version 2, or (at your option)
  19. # any later version.
  20. #
  21. # This program is distributed in the hope that it will be useful,
  22. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24. # GNU General Public License for more details.
  25. #
  26. # You should have received a copy of the GNU General Public License
  27. # along with this program; if not, write to the Free Software
  28. # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  29.  
  30.  
  31. ########################################
  32. my $uid = $<;
  33. my $username = getpwuid($uid);
  34.  
  35. ########################################
  36. # errors
  37. my $usage =
  38. "usage: fileshareset --add <dir>
  39.        fileshareset --remove <dir>";
  40. my $not_enabled =
  41. qq(File sharing is not enabled.
  42. To enable file sharing put 
  43. "FILESHARING=yes" in $authorisation_file);
  44.        
  45. my $not_simple_enabled = 
  46. qq(Simple file sharing is not enabled.
  47. To enable simple file sharing put
  48. "SHARINGMODE=simple" in $authorisation_file);
  49.  
  50. my $non_authorised =
  51. qq(You are not authorised to use file sharing
  52. To grant you the rights:
  53. - put "RESTRICT=no" in $authorisation_file
  54. - or put user "$username" in group "$authorisation_group");
  55.  
  56. my $no_export_method = "can't export anything: no nfs, no smb";
  57.  
  58. my %exit_codes = reverse (
  59.   1 => $non_authorised,
  60.   2 => $usage,
  61.  
  62. # when adding
  63.   3 => "already exported", 
  64.   4 => "invalid mount point",
  65.  
  66. # when removing
  67.   5 => "not exported",
  68.  
  69.   6 => $no_export_method,
  70.   
  71.   7 => $not_enabled,
  72.   
  73.   8 => $not_simple_enabled,
  74.  
  75.   255 => "various",
  76. );
  77.  
  78. ################################################################################
  79. # correct PATH needed to call /etc/init.d/... ? seems not, but...
  80. %ENV = ();#(PATH => '/bin:/sbin:/usr/bin:/usr/sbin');
  81.  
  82. my $modify = $0 =~ /fileshareset/;
  83.  
  84. authorisation::check($modify);
  85.  
  86. my @exports = (
  87.            -e $nfs_exports::conf_file ? nfs_exports::read() : (),
  88.            -e $smb_exports::conf_file ? smb_exports::read() : (),
  89.           );
  90. @exports or error($no_export_method);
  91.  
  92. if ($modify) {
  93.     my ($cmd, $dir) = @ARGV;
  94.     $< = $>;
  95.     @ARGV == 2 && ($cmd eq '--add' || $cmd eq '--remove') or error($usage);
  96.  
  97.     verify_mntpoint($dir);
  98.  
  99.     if ($cmd eq '--add') {
  100.     my @errs = map { eval { $_->add($dir) }; $@ } @exports;
  101.     grep { !$_ } @errs or error("already exported");
  102.     } else {
  103.     my @errs = map { eval { $_->remove($dir) }; $@ } @exports;
  104.     grep { !$_ } @errs or error("not exported");
  105.     }    
  106.     foreach my $export (@exports) {
  107.     $export->write;
  108.     $export->update_server;
  109.     }
  110. }
  111. my @mntpoints = grep {$_} uniq(map { map { $_->{mntpoint} } @$_ } @exports);
  112. print "$_\n" foreach grep { own($_) } @mntpoints;
  113.  
  114.  
  115. sub own { $uid == 0 || (stat($_[0]))[4] == $uid }
  116.  
  117. sub verify_mntpoint {
  118.     local ($_) = @_;
  119.     my $ok = 1;
  120.     $ok &&= m|^/|;
  121.     $ok &&= !m|/\.\./|;
  122.     $ok &&= !m|[\0\n\r]|;
  123.     $ok &&= -d $_;
  124.     $ok &&= own($_);
  125.     $ok or error("invalid mount point");
  126. }
  127.  
  128. sub error {
  129.     my ($string) = @_;
  130.     print STDERR "$string\n";
  131.     exit($exit_codes{$string} || 255);
  132. }
  133. sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
  134. sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
  135.  
  136.  
  137. ################################################################################
  138. package authorisation;
  139.  
  140. sub read_conf {
  141.     my ($exclusive_lock) = @_;
  142.     open F_lock, $authorisation_file; # don't care if it's missing
  143.     flock(F_lock, $exclusive_lock ? 2 : 1) or die "can't lock";
  144.     my %conf;
  145.     foreach (<F_lock>) {
  146.     s/#.*//; # remove comments
  147.     s/^\s+//; 
  148.     s/\s+$//;
  149.     /^$/ and next;
  150.     my ($cmd, $value) = split('=', $_, 2);
  151.     $conf{$cmd} = $value || warn qq(suspicious line "$_" in $authorisation_file\n);
  152.     }
  153.     # no close F_lock, keep it locked
  154.     \%conf
  155. }
  156.  
  157. sub check {
  158.     my ($exclusive_lock) = @_;
  159.     my $conf = read_conf($exclusive_lock);
  160.     if (lc($conf->{FILESHARING}) eq 'no') {
  161.       ::error($not_enabled);
  162.     }
  163.     
  164.     if (lc($conf->{SHARINGMODE}) eq 'advanced') {
  165.       ::error($not_simple_enabled);
  166.     }
  167.     
  168.     if (lc($conf->{FILESHAREGROUP} ne '')) {
  169.       $authorisation_group = lc($conf->{FILESHAREGROUP});
  170.     }      
  171.     
  172.     if (lc($conf->{RESTRICT}) eq 'no') {
  173.     # ok, access granted for everybody
  174.     } else {
  175.     my @l;
  176.     while (@l = getgrent) {
  177.         last if $l[0] eq $authorisation_group;
  178.     }
  179.     ::member($username, split(' ', $l[3])) or ::error($non_authorised);
  180.     }
  181. }
  182.  
  183. ################################################################################
  184. package exports;
  185.  
  186. sub find {
  187.     my ($exports, $mntpoint) = @_;
  188.     foreach (@$exports) {
  189.     $_->{mntpoint} eq $mntpoint and return $_;
  190.     }
  191.     undef;
  192. }
  193.  
  194. sub add {
  195.     my ($exports, $mntpoint) = @_;
  196.     foreach (@$exports) {
  197.     $_->{mntpoint} eq $mntpoint and die 'add';
  198.     }
  199.     push @$exports, my $e = { mntpoint => $mntpoint };
  200.     $e;
  201. }
  202.  
  203. sub remove {
  204.     my ($exports, $mntpoint) = @_;
  205.     my @l = grep { $_->{mntpoint} ne $mntpoint } @$exports;
  206.     @l < @$exports or die 'remove';
  207.     @$exports = @l;  
  208. }
  209.  
  210.  
  211. ################################################################################
  212. package nfs_exports;
  213.  
  214. use vars qw(@ISA $conf_file $default_options);
  215. BEGIN { @ISA = 'exports' }
  216.  
  217. sub read {
  218.     my $file = $conf_file;
  219.     local *F;
  220.     open F, $file or return [];
  221.  
  222.     my ($prev_raw, $prev_line, %e, @l);
  223.     my $line_nb = 0;
  224.     foreach my $raw (<F>) {
  225.     $line_nb++;
  226.     local $_ = $raw;
  227.     $raw .= "\n" if !/\n/;
  228.  
  229.     s/#.*//; # remove comments
  230.  
  231.     s/^\s+//; 
  232.     s/\s+$//; # remove unuseful spaces to help regexps
  233.  
  234.     if (/^$/) {
  235.         # blank lines ignored
  236.         $prev_raw .= $raw;
  237.         next;
  238.     }
  239.  
  240.     if (/\\$/) {
  241.         # line continue across lines
  242.         chop; # remove the backslash
  243.         $prev_line .= "$_ ";
  244.         $prev_raw .= $raw;
  245.         next;
  246.     }
  247.     my $line = $prev_line . $_;
  248.     my $raw_line = $prev_raw . $raw;
  249.     ($prev_line, $prev_raw) = ('', '');
  250.  
  251.     my ($mntpoint, $options) = $line =~ /("[^"]*"|\S+)\s+(.*)/ or die "$file:$line_nb: bad line $line\n";
  252.  
  253.     # You can also specify spaces or any other unusual characters in the
  254.     # export path name using a backslash followed by the character code as
  255.     # 3 octal digits.
  256.     $mntpoint =~ s/\\(\d{3})/chr(oct $1)/ge;
  257.  
  258.     # not accepting weird characters that would break the output
  259.     $mntpoint =~ m/[\0\n\r]/ and die "i won't handle this";
  260.     push @l, { mntpoint => $mntpoint, option => $options, raw => $raw_line };
  261.     }
  262.     bless \@l, 'nfs_exports';
  263. }
  264.  
  265. sub write {
  266.     my ($nfs_exports) = @_;
  267.     foreach (@$nfs_exports) {
  268.     if (!exists $_->{options}) {
  269.         $_->{options} = $default_options;
  270.     }
  271.     if (!exists $_->{raw}) {        
  272.         my $mntpoint = $_->{mntpoint} =~ /\s/ ? qq("$_->{mntpoint}") : $_->{mntpoint};
  273.         $_->{raw} = sprintf("%s %s\n", $mntpoint, $_->{options});
  274.     }
  275.     }
  276.     local *F;
  277.     open F, ">$conf_file" or die "can't write $conf_file";
  278.     print F $_->{raw} foreach @$nfs_exports;
  279. }
  280.  
  281. sub update_server {
  282.     if (fork) {
  283.     system('/usr/sbin/exportfs', '-r');
  284.     if (system('PATH=/bin:/sbin pidof rpc.mountd >/dev/null') != 0 ||
  285.         system('PATH=/bin:/sbin pidof nfsd >/dev/null') != 0) {
  286.         # trying to start the server...
  287.         system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status') != 0;
  288.         system('/etc/init.d/nfs', $_) foreach 'stop', 'start';
  289.     }
  290.     exit 0;
  291.     }
  292. }
  293.  
  294. ################################################################################
  295. package smb_exports;
  296.  
  297. use vars qw(@ISA $conf_file);
  298. BEGIN { @ISA = 'exports' }
  299.  
  300. sub read {
  301.     my ($s, @l);
  302.     local *F;
  303.     open F, $conf_file;
  304.     local $_;
  305.     while (<F>) {
  306.     if (/^\s*\[.*\]/ || eof F) {
  307.         #- first line in the category
  308.         my ($label) = $s =~ /^\s*\[(.*)\]/;
  309.         my ($mntpoint) = $s =~ /^\s*path\s*=\s*(.*)/m;
  310.         push @l, { mntpoint => $mntpoint, raw => $s, label => $label };
  311.         $s = '';
  312.     }
  313.     $s .= $_;
  314.     }
  315.     bless \@l, 'smb_exports';
  316. }
  317.  
  318. sub write {
  319.     my ($smb_exports) = @_;
  320.     foreach (@$smb_exports) {
  321.     if (!exists $_->{raw}) {
  322.         $_->{raw} = <<EOF;
  323.  
  324. [$_->{label}]
  325.    path = $_->{mntpoint}
  326.    comment = $_->{mntpoint}
  327.    public = yes
  328.    guest ok = yes
  329.    writable = no
  330.    wide links = no
  331. EOF
  332.     }
  333.     }
  334.     local *F;
  335.     open F, ">$conf_file" or die "can't write $conf_file";
  336.     print F $_->{raw} foreach @$smb_exports;
  337. }
  338.  
  339. sub add {
  340.     my ($exports, $mntpoint) = @_;
  341.     my $e = $exports->exports::add($mntpoint);
  342.     $e->{label} = name_mangle($mntpoint, map { $_->{label} } @$exports);
  343. }
  344.  
  345. sub name_mangle {
  346.     my ($input, @others) = @_;
  347.  
  348.     local $_ = $input;
  349.  
  350.     # 1. first only keep legal characters. "/" is also kept for the moment
  351.     tr|a-z|A-Z|;
  352.     s|[^A-Z0-9#\-_!/]|_|g; # "$" is allowed except at the end, remove it in any case
  353.     
  354.     # 2. removing non-interesting parts
  355.     s|^/||;
  356.     s|^home/||;
  357.     s|_*/_*|/|g;
  358.     s|_+|_|g;
  359.  
  360.     # 3. if size is too small (!), make it bigger
  361.     $_ .= "_" while length($_) < 3;
  362.  
  363.     # 4. if size is too big, shorten it
  364.     while (length > 12) {
  365.     my ($s) = m|.*?/(.*)|;
  366.     if (length($s) > 8 && !grep { /\Q$s/ } @others) {
  367.         # dropping leading directories when the resulting is still long and meaningful
  368.         $_ = $s;
  369.         next;
  370.     }
  371.     s|(.*)[0-9#\-_!/]|$1| and next;
  372.  
  373.     # inspired by "Christian Brolin" "Long names are doom" on comp.lang.functional
  374.     s|(.+)[AEIOU]|$1| and next; # allButFirstVowels
  375.     s|(.*)(.)\2|$1$2| and next; # adjacentDuplicates
  376.  
  377.     s|(.*).|$1|; # booh, :'-(
  378.     }
  379.  
  380.     # 5. remove "/"s still there
  381.     s|/|_|g;
  382.  
  383.     # 6. resolving conflicts
  384.     my $l = join("|", map { quotemeta } @others);
  385.     my $conflicts = qr|^($l)$|;
  386.     if (/$conflicts/) {
  387.       A: while (1) {
  388.         for (my $nb = 1; length("$_$nb") <= 12; $nb++) {
  389.         if ("$_$nb" !~ /$conflicts/) {
  390.             $_ = "$_$nb";
  391.             last A;
  392.         }
  393.         }
  394.         $_ or die "can't find a unique name";
  395.         # can't find a unique name, dropping the last letter
  396.         s|(.*).|$1|;
  397.     }
  398.     }
  399.  
  400.     # 7. done
  401.     $_;
  402. }
  403.  
  404. sub update_server {
  405.   if (fork) {
  406.     system('/usr/bin/killall -HUP smbd 2>/dev/null');
  407.     if (system('PATH=/bin:/sbin pidof smbd >/dev/null') != 0 ||
  408.     system('PATH=/bin:/sbin pidof nmbd >/dev/null') != 0) {
  409. # trying to start the server...
  410.       if ( -f '/etc/init.d/smb' ) {
  411.     system('/etc/init.d/smb', $_) foreach 'stop', 'start';
  412.       }
  413.       elsif ( -f '/etc/init.d/samba' ) {
  414.     system('/etc/init.d/samba', $_) foreach 'stop', 'start';
  415.       }
  416.       elsif ( -f '/etc/rc.d/rc.samba' ) {
  417.     system('/etc/rc.d/rc.samba', $_) foreach 'stop', 'start';
  418.       }
  419.       else {
  420.     print STDERR "Error: Can't find the samba init script \n";
  421.       }
  422.     }
  423.     exit 0;
  424.   }
  425. }
  426.